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-- file Pass4D.Mesa 

-- last modified by Satterthwaite, August 29, 1978 10:02 AM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
ComData: FROM "comdata", 
ControlDefs: FROM "controldef s M , 
ErrorDefs: FROM "errordefs", 
LitDefs: FROM "litdefs", 
P4Defs: FROM "p4defs\ 
SymDefs: FROM "symdefs", 
SymSegDefs: FROM "symsegdef s" , 
SymTabDefs: FROM "symtabdef s", 
TableDefs: FROM "tabledefs", 
TreeDefs: FROM "treedefs"; 

Pass4D: PROGRAM 
IMPORTS 

ErrorDefs, LitDefs, P4Defs, SymSegDefs, SymTabDefs, TreeDefs, 
dataPtr: ComData 
EXPORTS P4Defs ■ 
BEGIN 
OPEN TreeDefs, SymTabDefs, SymDefs; 

tb: TableDefs. TableBase; -- tree base address (local copy) 

seb: TableDefs. TableBase; -- se table base address (local copy) 

ctxb: TableDefs .TableBase; -- context table base address (local copy) 

bb: TableDefs. TableBase; -- body table base address (local copy) 

DeclNotify: PUBLIC TableDefs .TableNotif ier » 

BEGIN -- called by allocator whenever table area is repacked 

tb «- base[treetype]; 

seb <- base[setype] ; ctxb ♦- base[ctxtype]; 

bb <- base[bodytype]; RETURN 

END; 

Declltem: PUBLIC PROCEDURE [item: TreeLink] ■ 
BEGIN 

node: Treelndex ■ GetNode[i tern]; 
type: CSEIndex; 
expNode: Treelndex; 
initFlag, eqFlag: BOOLEAN; 

Explnit: PROCEDURE - 
BEGIN OPEN (tb+node); 
val , info: UNSPECIFIED; 
t: TreeLink; 
son3 <- P4Def s .RValue[son3 , BiasForType[type] , 

P4Def s .Target Rep [RepForType[ type]]]; 
IF ~AssignableRanges[type, P4Def s .OperandType[son3]] 

THEN son3 «- P4Def s .Resol veSizes[son3 , type]; 
IF eqFlag 
THEN 
BEGIN 
t «- son3; 

WHILE testtree[t, cast] 
DO 
WITH t SELECT FROM 

subtree => t «- ( tb+index) . sonl; 
ENDCASE; 
ENDLOOP; 
IF P4Defs.TreeLiteral[t] 
THEN 
BEGIN 

val ♦- P4Defs.TreeLiteralValue[t]; info ♦■ BTNull; GO TO define 
END; 
IF testtree[t, mwconst] 
THEN 
BEGIN 
WITH t SELECT FROM 

subtree •> (tb+index) . info *- type; 
ENDCASE; 
AugmentSEValue[sonl , t, FALSE]; son3 <- empty; 
val «- 0; info *- BTNull; GO TO define 
END; 
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IF (seb+type) .typetag ■ transfer 
THEN 

WITH t SELECT FROM 
symbol ■> 
BEGIN 

sei: ISEIndex ■ index; 
IF (seb+sei). constant 
THEN 
BEGIN 
IF (seb+sei). extended 

THEN AugmentSEVa1ue[sonl, 

SymSegDefs.FindExtension[sei], TRUE]; 
val ♦- (seb+sei) . idvalue; info <- (seb+sei) . idinfo; 
GO TO define 
END; 
END; 
ENDCASE; 
EXITS 

define ■> 
BEGIN 

Def ineSEValue[sonl, val, info]; 
son3 «- freetree[son3]; initFlag «- FALSE; 
END; 
END; 
SELECT (seb+Norma!Type[type]). typetag FROM 
pointer, arraydesc, relative ■> 

IF 1 istlength[sonl] # 1 AND son3 # empty 
AND ~P4Defs.TreeLiteral[son3] AND ~testtree[son3, mwconst] 
THEN ErrorDef s. Warn ing[ pointer In it] ; 
ENDCASE; 
P4Defs.VPop[]; RETURN 
END; 

savelndex: CARDINAL = dataPtr . textlndex; 

IF (tb+node).mark = P4Def s. P4Mark THEN RETURN; -- already processed 

(tb+node) .mark «- P4Def s.P4Mark; 

dataPtr. textlndex <- (tb+node) . info; 

initFlag «- (tb+node) . son3 # empty; 

IF testtree[( tb+node) . son2, modeTC] 

THEN TypeExp[typeExp: (tb+node) .son3, body:FALSE] 
ELSE 

BEGIN OPEN (tb+node); 
IF -initFlag 
THEN 
BEGIN 

TypeExp[typeExp:son2, body: FALSE]; 
type <- UnderType[TypeForTree[son2]]; 
WITH (seb+type) SELECT FROM 
record ■> 

IF FrameVars[sonl] AND 
(type - dataPtr. typeLOCK OR type ■ dataPtr. typeCONDITION) 
THEN son3 <- Processlni t[type] ; 
transfer =»> 
IF mode a port 
THEN 
BEGIN 

pushtree[portinit , 0]; setinfo[type] ; son3 *- mlpop[]; 
END; 
ENDCASE; 
END 
ELSE 

BEGIN eqFlag ♦• attrl; 
TypeExp[son2, testtree[son3 , body]]; 
type <- UnderType[TypeForTree[son2]]; 
WITH son3 SELECT FROM 

symbol, literal ■> Explnit[]; 
subtree ■> 

BEGIN expNode <- index; 
SELECT (tb+expNode).name FROM 
body «> 
BEGIN 

bti: CBTIndex - ( tb+expNode) . info; 
IF eqFlag 
THEN 
BEGIN 
DefineSEValue[ 
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sonl, 

P4Defs.MakeEPLink[(bb+bti). entry Index, 0], 
bti]; 
son3 «- empty; 
END 
ELSE 
BEGIN 

pushtree[body, 0]; setinfo[bti]; son3 «- mlpop[]; 
END; 
END; 
signalinit ■> 
IF eqFlag 
THEN 
BEGIN 

DefineSEValue[ 
sonl, 

P4Defs.MakeEPLink[(tb+expNode).info, 0], 
BTNull]; 
son3 <- f reetree[son3]; 
END; 
stringinit ■> 

BEGIN OPEN exp: ( tb+expNode) ; 
IF listlength[sonl] # 1 

THEN ErrorDef s . War ning[ pointer In it]; 
exp.son2 *- P4Def s . RVa1ue[exp.son2, 0, P4Defs. unsigned] ; 
IF P4Defs.TreeLiteralValue[exp.son2] < 

THEN ErrorDefs. error [stringLength]; 
P4Defs.VPop[]; 
END; 
inline ■> 
BEGIN 
(tb+expNode) .sonl «- 

update! ist[(tb+expNode) .sonl, InlineOp]; 
DefineSEValue[sonl, 0, BTNull]; 
AugmentSEValue[sonl, son3, FALSE]; 
son3 ♦- empty; initFlag ♦■ FALSE; 
END; 
ENDCASE ■> Explnit[]; 
END; 
ENDCASE; 
END; 
END; 
MarkAndCheckSE[(tb+node) .sonl, initFlag]; 
dataPtr.textlndex <- savelndex; RETURN 
END; 



FrameVars: PROCEDURE [t: TreeLink] RETURNS [BOOLEAN] ■ 
BEGIN 

s: TreeLink * listhead[t]; 
RETURN [WITH s SELECT FROM 

symbol ■> (ctxb+(seb+index) .ctxnum) . ctxlevel # 1Z, 

ENDCASE «> FALSE] 
END; 

Processlnit: PROCEDURE [type: CSEIndex] RETURNS [TreeLink] - 
BEGIN 

condlnit: ARRAY [0..2) OF WORD <- [0, 100]; 
SELECT type FROM 
dataPtr.typeLOCK -> 
BEGIN 

pushlittree[LitDefs.FindLiteral[100000B]]; push tree[ cast , 1]; 
END; 
dataPtr.typeCONDITION -> 
BEGIN 

pushlittree[LitDefs.FindLitDescriptor[DESCRIPTOR[condInit]]]; 
pushtree[mwconst, 1]; 
END; 
ENDCASE -> ERROR; 
setinfo[type]; RETURN [mlpop[]] 
END; 

InlineOp: TreeMap - 
BEGIN 

RETURN [updatelist[t, P4Def s .NeutralExp]] 
END; 



Pass4D.mesa 2-Sep-78 12:59:59 Page 4 



MarkAndCheckSE: PROCEDURE [t: TreeLink, initialized: BOOLEAN] ■ 
BEGIN 

UpdateSE: TreeScan ■ 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol ■> 

BEGIN sei <- index; 
(seb+sei) .mark4 «- TRUE; 

IF dataPtr.definitionsOnly THEN CheckDef inition[sei , initialized]; 
END; 
ENDCASE ■> ERROR; 
RETURN 
END; 

scanlist[t, UpdateSE]; RETURN 
END; 

CheckDefinition: PROCEDURE [sei: ISEIndex, initialized: BOOLEAN] - 
BEGIN 

SELECT (seb+sei). ctxnum FROM 
dataPtr.mainCtx «> 

SELECT XferMode[(seb+sei).idtype] FROM 

procedure, signal, error, program «> IF -initialized THEN RETURN; 
ENDCASE «> IF (seb+sei) . constant THEN RETURN; 
ENDCASE => IF -initialized OR (seb+sei) . constant THEN RETURN; 
ErrorDef s .errorsei[nonDef inition, sei]; RETURN 
END; 



DeclUpdate: PUBLIC PROCEDURE [item: TreeLink] RETURNS [update: TreeLink] 
BEGIN 

node: Treelndex ■ GetNode[item]; 

IF testtree[(tb+node) .son2, modeTC] OR (tb+node) .son3 ■ empty 
THEN update «- empty 
ELSE 

BEGIN OPEN (tb+node); 

P4Def s . Push Assignment [sonl, son3, UnderType[TypeForTree[son2]]] ; 
setinfo[info]; update «- mlpop[]; son3 «- empty; 
END; 
f reenode[node]; 
RETURN 
END; 

TypeExp: PUBLIC PROCEDURE [typeExp: TreeLink, body: BOOLEAN] - 
BEGIN -- body *> arg records subsumed by frame 
node, subNode: Treelndex; 
iSei: ISEIndex; 
sei, tSei: CSEIndex; 
rSei: recordCSEIndex; 
origin, newOrigin: CARDINAL; 
WordLength: CARDINAL * Al toDef s .wordlength ; 
ByteLength: CARDINAL = Al toDef s .charlength; 
WITH typeExp SELECT FROM 
symbol ■> 

BEGIN iSei <- index; 
IF ~(seb+iSei) .mark4 

THEN DeclItem[TreeLink[subtree[index: (seb+iSei) . idvalue]]]; 
END; 
subtree ■> 

BEGIN node <- index; 
SELECT (tb+node). name FROM 

discrimTC ■> TypeExp[typeExp: (tb+node) .sonl , body:FALSE]; 
cdot »> TypeExp[typeExp: (tb+node) .son2, body -.FALSE] ; 
frameTC -> NULL; 
ENDCASE -> 

BEGIN OPEN (tb+node); 
sei ♦- info; 

WITH type: (seb+sei) SELECT FROM 
enumerated »> NULL; 
record -> 
BEGIN 
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scanlist[sonl, Declltem]; 
WITH type SELECT FROM 
notlinked ■> 

P4Defs.LayoutFields[L00PH0LE[sei, recordCSEIndex] , 0]; 
ENDCASE; 
Extract Fi el dAttributes[LOOPHOLE[sei , recordCSEIndex]]; 
END; 
pointer ■> 

IF TypeConstructor[sonl] 

THEN TypeExp[typeExp:sonl, body.-FALSE]; 
array ■> 
BEGIN 

IF sonl # empty THEN TypeExp[typeExp : sonl, body:FALSE]; 
TypeExp[typeExp:son2, body: FALSE]; 

type. comparable <- ComparableType[UnderType[type.componenttype]]; 
END; 
arraydesc »> 

IF TypeConstructor[sonl] 

THEN TypeExp[typeExp:sonl, body.FALSE]; 
transfer ■> 
BEGIN 
origin <- SELECT type. mode FROM 

program ■> ControlDef s.globalbase, 
signal, error a > ControlDef s. localbase+1, 
procedure ■ > ControlDef s. localbase+1 , 
ENDCASE ■> 0; 
scan! ist[sonl, Declltem]; 
rSei «- type, inrecord; 
IF rSei # SENull 
THEN 
BEGIN 

newOrigin *- P4Def s .LayoutArgs[rSei f origin, body]; 
(seb+rSei ). length <- (newOrigin - origin)*WordLength; 
(seb+rSei).mark4 <- TRUE; 
origin *- newOrigin; 
END; 
scanlist[son2, Declltem]; 
rSei «- type.outrecord; 
IF rSei # SENull 
THEN 
BEGIN 
(seb+rSei) .length <- 

(P4Defs.LayoutArgs[rSei , origin, body] - origin)*WordLength; 
(seb+rSei) .mark4 «- TRUE; 
END; 
END; 
definition ■> NULL; 
union *> 
BEGIN 

DeclItem[sonl]; 
IF BiasForType[UnderType[(seb+type.tagsei) .idtype]] # 

THEN ErrorDef s.errorsei[nonTagType, type. tagsei]; 
scanl ist[son2, Declltem]; 
END; 
relative a > 
BEGIN 
IF TypeConstructor[sonl] 

THEN TypeExp[typeExp:sonl, body:FALSE]; 
IF TypeConstructor[son2] 

THEN TypeExp[typeExp:son2, body:FALSE]; 
END; 
subrange «> 
BEGIN 

TypeExp[typeExp:sonl , body: FALSE]; 
subNode <- GetNode[son2] ; 

IF ~P4Defs.Interval[subNode, 0, P4Defs.both] THEN ERROR; 
IF P4Defs.VRep[] « P4Defs.none 

THEN ErrorDef s .errortree[mixedRepresentation , son2]; 
[type. origin, type. range] <- P4Def s.ConstantInterval[subNode 
\ 1 P4Defs .Emptylnterval -> 

BEGIN type. empty «- TRUE; RESUME END]; 
P4Defs.VPop[]; 
type. filled *- TRUE; 
tSei <- UnderType[type. rangetype]; 
WITH cover: (seb+tSei) SELECT FROM 
subrange ■> -- incomplete test 
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IF type. origin < cover. origin 
OR (~type. empty AND type. range > cover. range) 
THEN ErrorDefs.error[subrangeNesting]; 
ENDCASE ■> NULL; 
son2 <- freetree[son2]; 
END; 
long ■> TypeExp[typeExp:sonl, body: FALSE]; 
ENDCASE ■> ERROR; 
(seb+sei) .mark4 ♦- TRUE; 
END; 
END; 
ENDCASE ■> ERROR; 
RETURN 
END; 

TypeConstructor: PROCEDURE [t: TreeLink] RETURNS [BOOLEAN] ■ 
BEGIN 

RETURN [WITH t SELECT FROM 
subtree ■> 

SELECT (tb+index).name FROM 
dot, cdot, discrimTC ■> FALSE, 
ENDCASE -> TRUE, 
ENDCASE »> FALSE] 
END; 

ExtractFieldAttributes: PROCEDURE [rType: recordCSEIndex] ■ 
BEGIN 

-- compatibility version 
sei: ISEIndex; 
type: CSEIndex; 

comparable, privateFields: BOOLEAN; 
comparable ♦- TRUE; privateFields «- FALSE; 

FOR sei <- (ctxb+(seb+rType) .f ieldctx) .sel ist , NextSe[sei] UNTIL sei ■ SENull 
DO 

IF -(seb+sei) .public THEN privateFields <- TRUE; 
type <- UnderType[(seb+sei) . idtype]; 
WITH t: (seb+type) SELECT FROM 
record »> 

IF ~t. comparable AND ~ComparableType[type] THEN comparable «- FALSE; 
array ■> 

IF ~t. comparable AND ~ComparableType[type] THEN comparable <- FALSE; 
union »> 

IF ~t.equa!Lengths THEN comparable «- FALSE; 
ENDCASE; 
ENDLOOP; 
(seb+rType) .comparable «- comparable; 
(seb+rType) .privateFields <- privateFields; 
RETURN 
END; 

TypeForTree: PUBLIC PROCEDURE [t: TreeLink] RETURNS [SEIndex] ■ 
BEGIN 
RETURN [WITH t SELECT FROM 

symbol a > index, 

subtree => (tb+index) . info, 

ENDCASE «> typeANY] 
END; 

DefineSEValue: PROCEDURE [t: TreeLink, value, info: UNSPECIFIED] ■ 
BEGIN 

UpdateSE: TreeScan ■ 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol a > 

BEGIN sei «- index; 
(seb+sei) . constant «- TRUE; 

(seb+sei) . idvalue <- value; (seb+sei ). idinfo «- info; 
END; 
ENDCASE -> ERROR; 
RETURN 
END; 

scanlist[t, UpdateSE]; RETURN 
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END; 

AugmentSEValue: PROCEDURE [t, extension: TreeLink, copy: BOOLEAN] « 
BEGIN 

UpdateSE: TreeScan ■ 
BEGIN 

WITH t SELECT FROM 
symbol ■> 
SymSegDef s.EnterExtension[index, 

IF copy THEN IdentityMap[extension] ELSE extension]; 
ENDCASE ■> ERROR; 
copy 4- TRUE; RETURN 
END; 

scanlist[t, UpdateSE]; RETURN 
END; 



BiasForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [INTEGER] ■ 
BEGIN 

ctx: CTXIndex; 

IF type - SENull THEN RETURN [0]; 
DO 

WITH (seb+type) SELECT FROM 
subrange -> RETURN [origin]; 
record ■> 

BEGIN ctx 4- fieldctx; 

IF -unifield OR CtxEntries[ctx] # 1 THEN RETURN [0]; 
type «- UnderType[(seb+(ctxb+ctx) . sel ist) . idtype]; 
END; 
ENDCASE -> RETURN [0] 
ENDLOOP; 
END; 

RepForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [P4Def s. Repr] ■ 
BEGIN 

ctx: CTXIndex; 

IF type ■ SENull THEN RETURN [P4Def s .none] ; 
DO 

WITH (seb+type) SELECT FROM 
basic ■> 

RETURN [SELECT code FROM 

codeANY ■> P4Defs.both + P4Defs. other, 
codelNTEGER «> P4Defs . signed, 
codeCHARACTER ■> P4Defs.both, 
ENDCASE -> P4Defs. other]; 
enumerated -> RETURN [P4Def s.both]; 
pointer -> RETURN [P4Defs .unsigned]; 
record ■> 

BEGIN ctx ♦- fieldctx; 

IF -unifield OR CtxEntries[ctx] § 1 THEN RETURN [P4Defs .other]; 
type «- UnderType[(seb+(ctxb+ctx) .sel ist) .idtype]; 
END; 
relative -> type 4- UnderType[offsetType]; 
subrange ■> 

RETURN [IF origin >■ 
THEN 

(IF CARDINAL[origin] + range > 77777B 
THEN P4Defs. unsigned ELSE P4Defs.both) 
ELSE 

(IF range <■ 77777B THEN P4Defs . signed ELSE P4Def s .none)]; 
ENDCASE -> RETURN [P4Defs . other] 
ENDLOOP; 
END; 

WordsForType: PUBLIC PROCEDURE [type: CSEIndex] RETURNS [nW: CARDINAL] - 
BEGIN 

WordLength: CARDINAL - Al toDef s .wordlength; 
IF -(seb+type) .mark4 
THEN 

nW ♦- ((P4Defs. Bits For Type[type]+(WordLength-l))/WordLength)*WordLength 
ELSE 
BEGIN 
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WITH (seb+type) SELECT FROM 
record «> lengthUsed «- TRUE; 
array ■> lengthUsed +• TRUE; 
ENDCASE ■> NULL; 
nW <- SymTabDefs.WordsForType[type]; 
END; 
RETURN 
END; 

AssignableRanges: PUBLIC PROCEDURE [lType, rType: CSEIndex] RETURNS [BOOLEAN] • 
BEGIN 

nw: CARDINAL; 

WITH 1: (seb+IType) SELECT FROM 
record ■> 

BEGIN 1. lengthUsed «- TRUE; 
WITH r: (seb+rType) SELECT FROM 
record ■> 

BEGIN r. lengthUsed <- TRUE; RETURN[1 . length - r. length] END; 
ENDCASE; 
END; 
ENDCASE; 
nw <- P4Defs.WordsForType[lType]; 

RETURN [(nw # 0) AND (P4Def s .WordsForType[rType] - nw)] 
END; 

ComparableRanges: PUBLIC PROCEDURE [typel, type2: CSEIndex] RETURNS [BOOLEAN] • 
BEGIN 

-- compatibility version 
nw: CARDINAL ■ P4Def s .WordsForType[typel] ; 

IF nw « OR P4Defs.WordsForType[type2] # nw THEN RETURN [FALSE]; 
RETURN [ComparableType[typel]] 
END; 

ComparableType: PROCEDURE [type: CSEIndex] RETURNS [BOOLEAN] - 

BEGIN 

-- compatibility version 

RETURN [WITH (seb+type) SELECT FROM 

record => comparable OR (-variant OR ComparableUnion[LOOPHOLE[type]]) , 
array => comparable OR ComparableType[UnderType[componenttype]] , 
ENDCASE ■> TRUE] 

END; 

ComparableUnion: PROCEDURE [rType: recordCSEIndex] RETURNS [BOOLEAN] - 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 

FOR sei «- (ctxb+(seb+rType) .f iel dctx) .sel ist, NextSe[sei] UNTIL sei « SENull 
DO 

type «- UnderType[(seb+sei) . idtype]; 
WITH (seb+type) SELECT FROM 

union -> RETURN [equalLengths]; 
ENDCASE; 
ENDLOOP; 
RETURN [FALSE] 
END; 

END. 



